home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASDEMO2 / D_LINK1.PAS next >
Pascal/Delphi Source File  |  1987-09-09  |  8KB  |  274 lines
  1. (* A mailing list
  2.    That uses a Double Linked List
  3.  
  4.    Here is a simple mailing list program that uses a double linked list. The
  5.    entire list is kept in memory while in use; howvwe, the program can be
  6.    modified to store the mailing list in a disk file. *)
  7.  
  8. program Mail_List;      { page 56 }
  9.  
  10. type Str80 = string[80];
  11.      AddrPointer = ^address;
  12.      address = record
  13.              Name:   string[30];
  14.              Street: string[40];
  15.              City:   string[20];
  16.              State:  string[2];
  17.              Zip:    string[9];
  18.              Next:   AddrPointer;   { pointer to next record }
  19.              Prior:  AddrPointer;   { pointer to previous record }
  20.           end;
  21.      DataItem  = address;
  22.      DataArray = array[ 1..100 ] of AddrPointer;
  23.                                          { hold pointers to address records }
  24.      filetype = file of address;
  25. var Test: DataArray;
  26.     T, T2:       integer;
  27.     MList:       FileType;
  28.     Start, Last: AddrPointer;
  29.     Done:        boolean;
  30.  
  31. function MenuSelect: char;  { return the users selection }
  32.    var ch: char;
  33.    begin
  34.       writeln( '1. Enter names' );
  35.       writeln( '2. Delete a name' );
  36.       writeln( '3. Display the list' );
  37.       writeln( '4. Search the list' );
  38.       writeln( '5. Save the list' );
  39.       writeln( '6. Load the list' );
  40.       writeln( '7. Quit' );
  41.       repeat
  42.          writeln;
  43.          write( 'Enter your choice: ' );
  44.          read( ch ); ch := upcase( ch ); writeln;
  45.       until ( ch >= '1' ) and ( ch <= '7' );
  46.       Menuselect := ch;
  47.    end; { MenuSelect }
  48.  
  49. function DSL_Store( Info, Start: AddrPointer; var Last: AddrPointer ):
  50.                     AddrPointer; { store entries in sorted order }
  51.    var Old, Top: ^Address;
  52.        Done: boolean;
  53.    begin
  54.       Top := Start;
  55.       Old := nil;
  56.       Done := false;
  57.  
  58.       if Start = nil then
  59.       begin  { first element in list }
  60.          Info^.Next := nil;
  61.          Last := Info;
  62.          Info^.Prior := nil;
  63.          DSL_Store := Info;
  64.       end else
  65.       begin
  66.          while ( start <> nil ) and ( not Done ) do
  67.          begin
  68.             if Start^. Name < Info^.Name then
  69.             begin
  70.                Old := Start;
  71.                Start := Start^.Next;
  72.             end else
  73.             begin   { goes in middle }
  74.                if Old <> nil then
  75.                begin
  76.                   Old^.Next := Info;
  77.                   Info^.Next := Start;
  78.                   Start^.Prior := Info;
  79.                   Info^.Prior := Old;
  80.                   DSL_Store := Top;  { keep same starting point }
  81.                   Done := true;
  82.                end else
  83.                begin
  84.                   Info^.Next := Start;  { new first element }
  85.                   Info^.Prior := Info;
  86.                   Done := true;
  87.                end;
  88.             end;
  89.          end { while };
  90.          if not Done then
  91.          begin
  92.             Last^.Next := Info;  { goes on end }
  93.             Info^.Next := nil;
  94.             Info^.Prior := Last;
  95.             Last := Info;
  96.             DSL_Store := Top;
  97.          end;
  98.       end;
  99.    end; { DSL_Store }
  100.  
  101. function DL_Delete( Start: AddrPointer; key: str80 ): AddrPointer;
  102.    var Temp, Temp2: AddrPointer;
  103.        Done: boolean;
  104.    begin
  105.       if Start^.Name = key then
  106.       begin
  107.          DL_Delete := Start^.Next;
  108.          if Temp^.Next <> nil then
  109.          begin
  110.             Temp := Start^.Next;
  111.             Temp^.Prior := nil;
  112.          end;
  113.          dispose( Start );
  114.       end else
  115.       begin
  116.          Done := false;
  117.          Temp := Start^.Next;
  118.          Temp2 := Start;
  119.          while ( Temp <> nil ) and ( not Done ) do
  120.          begin
  121.             if Temp^.Name = key then
  122.             begin
  123.                Temp2^.Next := Temp^.Next;
  124.                if Temp^.Next <> nil then
  125.                   Temp^.Next^.Prior := Temp2;
  126.                Done := True;
  127.                dispose( Temp );
  128.             end else
  129.             begin
  130.                Temp2 := Temp;
  131.                Temp := Temp^.Next;
  132.             end;
  133.          end;
  134.          DL_Delete := Start;   { still same starting point }
  135.          if not Done then Writeln( 'not found' );
  136.       end;
  137.    end { DL_Delete };
  138.  
  139. procedure Remove;
  140.    var Name: Str80;
  141.    begin
  142.       write( 'Enter name to delete: ' );
  143.       read( Name ); writeln;
  144.       Start := DL_Delete( Start, Name );
  145.    end { Remove };
  146.  
  147. procedure Enter;
  148.    var Info: AddrPointer;
  149.        Done: boolean;
  150.    begin
  151.       Done := false;
  152.       repeat
  153.          new( Info );   { get a new record }
  154.          write( 'Enter name: ' );
  155.          read( Info^.Name );
  156.          writeln;
  157.          if length( Info^.Name ) = 0 then Done := true
  158.          else begin
  159.             write( 'Enter street: ' );
  160.             readln( Info^.Street );
  161.             write( 'Enter city: ' );
  162.             readln( Info^.City );
  163.             write( 'Enter state: ' );
  164.             readln( Info^.State );
  165.             write( 'Enter zip: ' );
  166.             readln( Info^.Zip );
  167.             Start := DSL_Store( Info, Start, Last );   { store it }
  168.          end;
  169.       until Done;
  170.    end { Enter };
  171.  
  172. procedure Display( Start: AddrPointer );
  173.    begin
  174.       while Start <> nil do begin
  175.          writeln( Start^.Name );
  176.          writeln( Start^.Street );
  177.          writeln( Start^.City );
  178.          writeln( Start^.State );
  179.          writeln( Start^.Zip );
  180.          Start := Start^.Next;
  181.       end { while };
  182.    end { Display };
  183.  
  184. function Search( Start: AddrPointer; Name: Str80 ): AddrPointer;
  185.    var Done: boolean;
  186.    begin
  187.       Done := false;
  188.       while ( Start <> nil ) and ( not Done ) do begin
  189.          if Name = Start^.Name then
  190.             begin Search := Start;
  191.                   Done := true;
  192.             end
  193.          else Start := Start^.Next;
  194.       end { while };
  195.       if Start = nil then Search := nil;   { not in list }
  196.    end { Search };
  197.  
  198. procedure Find;
  199.    var Loc: AddrPointer;
  200.        Name: Str80;
  201.    begin
  202.       write( 'Enter name to find: ' );
  203.       readln( Name );
  204.       Loc := Search( Start, Name );
  205.       if Loc <> nil then writeln( Loc^.Name )
  206.       else writeln( 'not in list ' );
  207.    end { Find };
  208.  
  209. procedure Save( var F: FileType; Start: AddrPointer );
  210.    begin
  211.       writeln( 'saving file' );
  212.       rewrite( F );
  213.       while STart <> nil do
  214.       begin
  215.          write( F, Start^ );
  216.          Start := Start^.Next;
  217.       end;
  218.    end { Save };
  219.  
  220. function Load( var F: FileType; Start: AddrPointer ): AddrPointer;
  221. { return a pointer to the start of the list }
  222.    var Temp, Temp2: AddrPointer;
  223.        First: boolean;
  224.    begin
  225.       writeln( 'Load file' );
  226.       reset( F );
  227.       while Start <> nil do
  228.       begin   { free memory, if any }
  229.          Temp := Start^.Next;
  230.          dispose( Start );
  231.          Start := Temp;
  232.       end;
  233.  
  234.       Start := nil; Last := nil;
  235.       if not eof( F ) then
  236.       begin
  237.          new( Temp );
  238.          read( F, Temp^ );
  239.          Temp^.Next := nil;  Temp^.Prior := nil;
  240.          Load := Temp;   { pointer to start of list }
  241.       end;
  242.  
  243.       while not eof( F ) do
  244.       begin
  245.          New( Temp2 );
  246.          read( F, Temp2^ );
  247.          Temp^.Next := Temp2; { build list }
  248.          Temp2^.Next := nil;
  249.          Temp^.Prior := Temp2;
  250.          Temp := Temp2;
  251.       end;
  252.       Last := Temp2;
  253.    end; { Load }
  254.  
  255. begin
  256.    Start := nil;   { initially empty list }
  257.    Last := nil;
  258.    Done := false;
  259.  
  260.    Assign( MList, 'a:\advanced\mlist.dat' );
  261.  
  262.    repeat
  263.       case MenuSelect of
  264.          '1': Enter;
  265.          '2': Remove;
  266.          '3': Display( Start );
  267.          '4': Find;
  268.          '5': Save( MList, Start );
  269.          '6': Start := Load( MList, Start );
  270.          '7': Done := true;
  271.       end;
  272.    until Done = true;
  273.  
  274. end. { MList }